unit UDbSet;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Registry, IniFiles, ADODB;

type
  TFrmDbSet = class(TForm)
    lblServer: TLabel;
    lblUID: TLabel;
    lblPWD: TLabel;
    lblDBName: TLabel;
    edtServer: TEdit;
    edtUID: TEdit;
    edtPWD: TEdit;
    cbbDBName: TComboBox;
    btnOK: TButton;
    btnCancel: TButton;
    chkTrust: TCheckBox;
    rgtype: TRadioGroup;
    procedure cbbDBNameDropDown(Sender: TObject);
    procedure rgtypeClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    function BuildConnectionString(ConnectOnly: Boolean): string;
  public
    { Public declarations }
  end;

resourcestring
  regodbc='注册驱动失败!';
  linkfail='连接数据库失败';

const
  RtMachineKey = HKEY_LOCAL_MACHINE;
  MachineodbcdriverKey:String='\SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers';
  MachinemysqldriverKey:String='\SOFTWARE\ODBC\ODBCINST.INI\MySQL ODBC 3.51 Driver';
  RtuserKey = HKEY_CURRENT_USER;
  UserodbcsourceKey:String='\Software\ODBC\ODBC.INI\ODBC Data Sources';
  UserodbcmysqlKey:String='\Software\ODBC\ODBC.INI\odbcmysql';

  var
  FrmDbSet: TFrmDbSet;

implementation

uses umain;

{$R *.dfm}

function TFrmDbSet.BuildConnectionString(ConnectOnly: Boolean): string;
begin
  Result:='';
  if rgtype.ItemIndex=1 then
  begin
    Result := 'Provider=SQLOLEDB.1;';
    if edtServer.Text<>'' then
      Result := Result + format('Data Source=%s;', [edtServer.Text]);
    if chkTrust.Checked then
    begin
      Result := Result + 'Integrated Security=SSPI;';
    end else
    begin
      Result := Result + format('User ID=%s;', [edtUID.Text]);
      if edtPWD.Text <> '' then
        Result := Result + format('Password=%s;', [edtPWD.Text]);
    end;
    if not ConnectOnly then
      Result := Result + format('Initial Catalog=%s;', [cbbDBName.Text]);
    if Copy(Result, Length(Result), 1) = ';' then Delete(Result, Length(Result), 1);
  end else
  begin
    Result:='Provider=MSDASQL.1;Persist Security Info=False;Data Source=odbcmysql ';
  end;
end;


procedure TFrmDbSet.cbbDBNameDropDown(Sender: TObject);
var
  Conn: TADOConnection;
  ds: TADODataSet;
  SaveCursor: TCursor;
begin
  with cbbDBName.Items do
  begin
    Conn:=TADOConnection.Create(Self);
    ds:= TADODataSet.Create(Self);
    BeginUpdate;
    SaveCursor:=Screen.Cursor;
    Screen.Cursor:=crHourGlass;
    try
      Clear;
      Conn.LoginPrompt:=False;
      Conn.KeepConnection:=False;
      Conn.ConnectionString:=BuildConnectionString(True);
      if rgtype.ItemIndex=1 then
          Conn.Provider := 'SQLOLEDB.1'
      else
          Conn.Provider := 'MSDASQL.1';
      try
        conn.Open;
        conn.Close;
      except
        Screen.Cursor:=SaveCursor;      
        showmessage(linkfail);
        exit;
      end;
      Conn.ConnectionTimeOut:=10;
      ds.Connection:=Conn;
      ds.CommandType:=cmdText;
      if rgtype.ItemIndex=1 then
      begin
        ds.CommandText:='exec sp_catalogs_rowset;2 null';
        ds.Prepared:=True;
        ds.Open;
        ds.First;
        while not ds.Eof do
        begin
          Add(ds.FieldByName('CATALOG_NAME').AsString);
          ds.Next;
        end;
      end else
      begin
        try
          ds.CommandText:='show databases ';
        except
        end;
          ds.Prepared:=True;
          ds.Open;
        ds.First;
        while not ds.Eof do
        begin
          if (ds.FieldByName('Database').AsString<>'mysql') and
             (ds.FieldByName('Database').AsString<>'information_schema') then
            Add(ds.FieldByName('Database').AsString);
          ds.Next;
        end;
      end;
    finally
      Screen.Cursor:=SaveCursor;
      EndUpdate;
      ds.Free;
      Conn.Free;
    end;
  end;

end;

procedure TFrmDbSet.rgtypeClick(Sender: TObject);
begin
   if rgtype.ItemIndex = 0 then
      edtUID.Text := 'root'
   else if rgtype.ItemIndex = 1 then
      edtUID.Text := 'sa'
end;

procedure TFrmDbSet.FormShow(Sender: TObject);
begin
  rgtypeClick(nil);
end;

end.
